(module interp (lib "eopl.ss" "eopl")
  
  (require "drscheme-init.scm")

  (require "lang.scm")
  (require "data-structures.scm")
  (require "environments.scm")
  (require "store.scm")
  
  (provide value-of-program value-of instrument-let instrument-newref)

;;;;;;;;;;;;;;;; switches for instrument-let ;;;;;;;;;;;;;;;;

  (define instrument-let (make-parameter #f))

  ;; say (instrument-let #t) to turn instrumentation on.
  ;;     (instrument-let #f) to turn it off again.

  ;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;

  ;; value-of-program : program -> expval

  (define value-of-program 
    (lambda (pgm)
      (initialize-store!)             
      (cases program pgm
        (a-program (body)
          (value-of body (init-env))))))

  ;; value-of : expression * environment -> expval

  (define value-of
    (lambda (exp env)
      (cases expression exp

        (lit-exp (num) (num-val num))

        (var-exp (id) (deref (apply-env env id)))

        (diff-exp (exp1 exp2)
          (let ((val1
		  (expval->num
		    (value-of exp1 env)))
                (val2
		  (expval->num
		    (value-of exp2 env))))
            (num-val
	      (- val1 val2))))
        
        (zero?-exp (exp1)
	  (let ((val1 (expval->num (value-of exp1 env))))
	    (if (zero? val1)
	      (bool-val #t)
	      (bool-val #f))))

        (if-exp (exp0 exp1 exp2) 
          (if (expval->bool (value-of exp0 env))
            (value-of exp1 env)
            (value-of exp2 env)))

        
        (let-exp (idents r-vals body) 
                 (if (instrument-let)
                     (eopl:printf "entering let ~s~%" (car idents)))                 
                 (letrec
                     ((extend-let-env
                       (lambda (ids r-vals s-env)
                         (if (null? ids)
                             s-env
                             (let ((val (value-of (car r-vals) s-env)))
                               (let ((new-env (extend-env (car ids) (newref val) s-env)))
                                 (if (instrument-let)
                                     (begin
                                       (eopl:printf "entering body of let ~s with env =~%" (car ids))
                                       (pretty-print (env->list new-env))
                                       (eopl:printf "store =~%")
                                       (pretty-print (store->list (get-store-as-list)))
                                       (eopl:printf "~%")
                                       ))                                 
                                 (extend-let-env (cdr ids) (cdr r-vals) new-env)))))))
                   (value-of body (extend-let-env idents r-vals env)))
                 )

        (proc-exp (bvars body)
	  (proc-val
	    (procedure bvars body env)))

        (app-exp (rator rands)          
                 (let ((proc (expval->proc (value-of rator env)))
                       ;;(arg  (value-of rand env)) --old style single arg
                       (args (letrec 
                                 ((get-value-list
                                   (lambda (arguments senv)
                                     (if (null? arguments) 
                                         ()
                                         (cons (value-of (car arguments) senv) 
                                                (get-value-list (cdr arguments) senv))))))
                                  (get-value-list rands env)))
                             )
                       (apply-procedure proc args)))

        (letrec-exp (proc-names bvars proc-bodies letrec-body)
          (value-of letrec-body
            (extend-env-recursively proc-names bvars proc-bodies env)))

        (begin-exp (e1 es)
          (letrec 
            ((value-of-begins
               (lambda (e1 es)
                 (let ((v1 (value-of e1 env)))
                   (if (null? es)
                     v1
                     (value-of-begins (car es) (cdr es)))))))
            (value-of-begins e1 es)))

        (assign-exp (x e)
          (begin
            (setref!
              (apply-env env x)
              (value-of e env))
            (num-val 27)))


        )))

  ;; apply-procedure : procedure * expval -> expval

  (define apply-procedure
    (lambda (proc1 args)
      (cases proc proc1
        (procedure (bvars body saved-env)
                   (letrec 
                       ((extend-args-env
                         (lambda (arguments bindvars s-env)
                           (if (null? bindvars) 
                               ;;(if (null? bindvars) 
                               s-env
                               ;;    (eopl:error "Bad Args Count")
                               ;;    )    
                               (let ((r (newref (car arguments))))
                                 (let ((new-env (extend-env (car bindvars) r s-env)))
                                   (if (instrument-let)
                                       (begin
                                         (eopl:printf
                                          "entering body of proc ~s with env =~%"
                                         (car bindvars))
                                         (pretty-print (env->list new-env)) 
                                         (eopl:printf "store =~%")
                                         (pretty-print (store->list (get-store-as-list)))
                                         (eopl:printf "~%")))
                                   
                                   (extend-args-env (cdr arguments) (cdr bindvars) new-env)
                                   ))))))
                     (value-of body (extend-args-env args bvars saved-env)))
                   
                   )
        )
      )
    )

  
  ;; store->list : (list expval) -> (list num displayable-expvals)

 (define store->list
    (lambda (sto)
      (letrec
	((store->list-inner
	   ;; convert sto to list as if its car was location n
	   (lambda (sto n)
	     (if (null? sto)
	       '()
	       (cons
		 (list n (expval->printable (car sto)))
		 (store->list-inner (cdr sto) (+ n 1)))))))
	(store->list-inner sto 0))))

 ;; like expval, except procedures get cleaned up with env->list
 (define expval->printable
   (lambda (val)
     (cases expval val
       (proc-val (p)
	 (cases proc p
	   (procedure (var e env)
	     (list 'procedure var '... (env->list env)))))
       (else val))))
       

  )
  


  
